home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / scsh / stringcoll.scm < prev    next >
Text File  |  1995-10-13  |  7KB  |  167 lines
  1. ;;; Copyright (c) 1994 by Olin Shivers
  2.  
  3. ;;; String collectors
  4. ;;; ===========================================================================
  5. ;;; string-colllector
  6. ;;; (make-string-collector)
  7. ;;; (collect-string! SC S)
  8. ;;; (clear-string-collector! SC)
  9. ;;; (string-collector->string SC)
  10. ;;;
  11. ;;; A string collector is a data structure that reduces the overhead of
  12. ;;; accumulating a large string in bits and pieces. It is basically a 
  13. ;;; "chunk list," where a chunk is a string of at least 128 chars. In this
  14. ;;; way, the list overhead is kept under 2% of the whole data structure.
  15. ;;; When a new string is added to the collection, it is added to the current
  16. ;;; chunk. When the chunk reaches 128 chars, it is added to the chunk list,
  17. ;;; and a new chunk is started. If a large string is added to the collection, 
  18. ;;; it is added as a chunk itself, so large strings are not split into small 
  19. ;;; pieces. (Actually, a *copy* of the original large string is saved as a 
  20. ;;; single chunk, so the collector's chunks are not shared with client data.)
  21. ;;;
  22. ;;; MAKE-STRING-COLLECTOR allocates a new string collector data structure.
  23. ;;; COLLECT-STRING! appends a string to the current collection.
  24. ;;; CLEAR-STRING-COLLECTOR! clears out accumulated strings from a collector.
  25. ;;; STRING-COLLECTOR->STRING converts a collector into a contiguous string.
  26. ;;;
  27. ;;; This facility makes it reasonably efficient to accumulate strings
  28. ;;; of any size in increments of any size.
  29.  
  30. (define-record string-collector
  31.   (len 0)        ; How many chars have we accumulated?
  32.   (chunks '())        ; The chunk list.
  33.   (chunk #f)        ; The current chunk being filled, if any.
  34.   (chunk-left  0))    ; How many chars left to fill in the current chunk.
  35.  
  36. (define (clear-string-collector! sc)
  37.   (set-string-collector:len    sc 0)
  38.   (set-string-collector:chunks sc '())
  39.   (set-string-collector:chunk  sc #f)
  40.   sc)
  41.  
  42. ;;; (COLLECT-STRING! sc s)
  43. ;;; ----------------------
  44. ;;; S is a string. Append it to the string being collected in the
  45. ;;; string-collector SC.
  46. ;;;
  47. ;;; The algorithm:
  48. ;;; First, do nothing if S is the empty string. Otherwise:
  49. ;;; If there is a current chunk:
  50. ;;;    Copy characters from S into it.
  51. ;;;    If we filled up the chunk
  52. ;;;        Put the chunk on the chunk list.
  53. ;;;        Look at the remaining chars from S we haven't copied yet.
  54. ;;;        If there a lot of characters left (>= 128)
  55. ;;;            Save them as a single chunk on the chunk list.
  56. ;;;            No current chunk.
  57. ;;;       Else if there a just a few characters left (> 0, < 128)
  58. ;;;            Start a new current chunk, copy the chars left into it.
  59. ;;;        Else if there aren't any characters left
  60. ;;;            No current chunk.
  61. ;;;
  62. ;;; If there is no current chunk:
  63. ;;;     If there are a lot of characters in S (>= 128)
  64. ;;;         Save a copy of S as a single chunk on the chunk list.
  65. ;;;         Still no current chunk.
  66. ;;;     Else if there are a few characters in S (> 0, < 128)
  67. ;;;         Start a new current chunk, copy the S into it.
  68.  
  69. (define (collect-string! sc s)
  70.   (let ((slen (string-length s))
  71.     (chunk (string-collector:chunk sc))
  72.     (chunk-left (string-collector:chunk-left sc))
  73.  
  74.     ;; Add the chunk C to the collector's chunk list.
  75.     (push-chunk! (lambda (c)
  76.                (set-string-collector:chunks sc
  77.                    (cons c (string-collector:chunks sc)))))
  78.  
  79.     ;; Copy nchars characters from src[j] to dest[i]
  80.     ;; *Way* too much bounds checking going on in this loop.
  81.     (copy-substring! (lambda (dest i src j nchars)
  82.       (do ((i i (+ i 1))
  83.            (j j (+ j 1))
  84.            (nchars nchars (- nchars 1)))
  85.           ((zero? nchars))
  86.         (string-set! dest i (string-ref src j))))))
  87.  
  88.     (cond ((zero? slen)) ; Empty string, do nothing.
  89.       (chunk
  90.        (let ((ncopy (min slen chunk-left)))
  91.          (copy-substring! chunk (- 128 chunk-left) s 0 ncopy)
  92.          (if (> chunk-left slen)
  93.          (set-string-collector:chunk-left sc (- chunk-left slen))
  94.          ;; Current chunk is full.
  95.          (let ((s-left (- slen chunk-left)))
  96.            (push-chunk! chunk) ; Push the current chunk.
  97.            ;; Handle remaining chars from S that weren't copied into
  98.            ;; the current chunk we just pushed:
  99.            (cond ((>= s-left 128)
  100.               ;; A lot more chars left. Push them as one chunk.
  101.               (push-chunk! (substring s chunk-left slen))
  102.               (set-string-collector:chunk sc #f))
  103.              ((> s-left 0)
  104.               ;; A few more chars left. Start a new chunk.
  105.               (let ((new-chunk (make-string 128)))
  106.                 (copy-substring! new-chunk 0 s chunk-left s-left)
  107.                 (set-string-collector:chunk sc new-chunk)
  108.                 (set-string-collector:chunk-left sc
  109.                                  (- 128 s-left))))
  110.              ;; No more chars left. No current chunk.
  111.              (else (set-string-collector:chunk sc #f)))))))
  112.  
  113.       (else ; No current chunk.
  114.        (if (>= slen 128)  ; How many chars is S?
  115.            (push-chunk! (string-copy s))    ; A lot. Push as one chunk.
  116.            (let ((chunk (make-string 128))) ; Not many. Start a new chunk.
  117.             (set-string-collector:chunk sc chunk)
  118.             (copy-substring! chunk 0 s 0 slen)
  119.             (set-string-collector:chunk-left sc (- 128 slen))))))
  120.  
  121.   ;; We don't actually do anything with this, but we keep it updated anyway.
  122.   (set-string-collector:len sc (+ (string-collector:len sc) slen))
  123.   sc))
  124.                   
  125.          
  126. ;;; A bummed version for collecting a single character.
  127.  
  128. (define (collect-char! sc c)
  129.   (let ((chunk (string-collector:chunk sc))
  130.     (chunk-left (string-collector:chunk-left sc)))
  131.  
  132.     (cond (chunk
  133.        (string-set! chunk (- 128 chunk-left) c)
  134.        (cond ((> chunk-left 1)
  135.           (set-string-collector:chunk-left (- chunk-left 1)))
  136.          (else
  137.           (set-string-collector:chunks sc
  138.                (cons chunk (string-collector:chunks sc)))
  139.           (set-string-collector:chunk sc #f))))
  140.       (else
  141.        (let ((new-chunk (make-string 128 c)))
  142.          (set-string-collector:chunk-left 127)
  143.          (set-string-collector:chunk sc new-chunk)))))
  144.  
  145.   ;; We don't actually do anything with this, but we keep it updated anyway.
  146.   (set-string-collector:len sc (+ (string-collector:len sc) 1))
  147.   sc)
  148.  
  149.  
  150. ;;; Convert the data in the string-collector SC to a single contiguous
  151. ;;; string and return it.
  152.  
  153. (define (string-collector->string sc)
  154.   (let ((chunk  (string-collector:chunk sc))
  155.     (chunks (string-collector:chunks sc)))
  156.     (apply string-append
  157.        (reverse (if chunk
  158.             (cons (substring chunk 0
  159.                      (- 128
  160.                         (string-collector:chunk-left sc)))
  161.                   chunks)
  162.             chunks)))))
  163.  
  164. ;;; It's too bad we can't side-effect the string-collector's chunk list
  165. ;;; to be a single chunk after this coalescing operation, but we don't
  166. ;;; want to share the string we return -- the user might side-effect it.
  167.